home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / likene1a / frmmenu.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-09-24  |  4.6 KB  |  168 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMenu 
  3.    Caption         =   "Form2"
  4.    ClientHeight    =   3165
  5.    ClientLeft      =   -195
  6.    ClientTop       =   4290
  7.    ClientWidth     =   4680
  8.    LinkTopic       =   "Form2"
  9.    ScaleHeight     =   3165
  10.    ScaleWidth      =   4680
  11.    Begin VB.Timer Timer1 
  12.       Left            =   1080
  13.       Top             =   2040
  14.    End
  15.    Begin VB.Menu mnuFile 
  16.       Caption         =   "File"
  17.       Begin VB.Menu MnuPlay 
  18.          Caption         =   "Play"
  19.       End
  20.       Begin VB.Menu MnuStop 
  21.          Caption         =   "Stop"
  22.       End
  23.       Begin VB.Menu MnuPause 
  24.          Caption         =   "Pause"
  25.       End
  26.       Begin VB.Menu MnuEject 
  27.          Caption         =   "Eject"
  28.       End
  29.    End
  30. Attribute VB_Name = "Frmmenu"
  31. Attribute VB_GlobalNameSpace = False
  32. Attribute VB_Creatable = False
  33. Attribute VB_PredeclaredId = True
  34. Attribute VB_Exposed = False
  35. Private Sub MnuEject_Click()
  36. SendMCIString "set cd door open", True
  37. Update
  38. End Sub
  39. Private Sub MnuExit_Click()
  40. SendMCIString "pause cd", True
  41. fPlaying = False
  42. End Sub
  43. Private Sub MnuPause_Click()
  44. SendMCIString "pause cd", True
  45. fPlaying = False
  46. Update
  47. End Sub
  48. Private Sub MnuPlay_Click()
  49. SendMCIString "play cd", True
  50. fPlaying = True
  51. End Sub
  52. Private Sub MnuStop_Click()
  53. SendMCIString "stop cd wait", True
  54. cmd = "seek cd to " & Track
  55. SendMCIString MnuStop, True
  56. fPlaying = False
  57. Update
  58. End Sub
  59. Private Function SendMCIString(cmd As String, fShowError As Boolean) As Boolean
  60. Static rc As Long
  61. Static errStr As String * 200
  62. rc = mciSendString(cmd, 0, 0, hWnd)
  63. If (fShowError And rc <> 0) Then
  64. End If
  65. SendMCIString = (rc = 0)
  66. End Function
  67. Private Sub Command1_Click()
  68. Snd.CloseCD
  69. End Sub
  70. Private Sub Command7_Click()
  71. End Sub
  72. Private Sub Command8_Click()
  73. End Sub
  74. Private Sub alwaysontop_Click()
  75. End Sub
  76. Private Sub Form_Load()
  77. Timer1.Enabled = False
  78. fastForwardSpeed = 5
  79. fCDLoaded = False
  80. If (SendMCIString("open cdaudio alias cd wait shareable", True) = False) Then
  81. End If
  82. SendMCIString "set cd time format tmsf wait", True
  83. Timer1.Enabled = True
  84. End Sub
  85. Private Sub Form_Unload(Cancel As Integer)
  86. SendMCIString "close all", False
  87. End Sub
  88. Private Sub play_Click()
  89. SendMCIString "play cd", True
  90. fPlaying = True
  91. End Sub
  92. Private Sub REMontop_Click()
  93. End Sub
  94. Private Sub pause_Click()
  95. SendMCIString "pause cd", True
  96. fPlaying = False
  97. Update
  98. End Sub
  99. Private Sub eject_Click()
  100. SendMCIString "set cd door open", True
  101. Update
  102. End Sub
  103. Private Sub ff_Click()
  104. Dim s As String * 40
  105. SendMCIString "set cd time format milliseconds", True
  106. mciSendString "status cd position wait", s, Len(s), 0
  107. If (fPlaying) Then
  108.     cmd = "play cd from " & CStr(CLng(s) + fastForwardSpeed * 1000)
  109.     cmd = "seek cd to " & CStr(CLng(s) + fastForwardSpeed * 1000)
  110. End If
  111. mciSendString cmd, 0, 0, 0
  112. SendMCIString "set cd time format tmsf", True
  113. Update
  114. End Sub
  115. Private Sub rew_Click()
  116. Dim s As String * 40
  117. SendMCIString "set cd time format milliseconds", True
  118. mciSendString "status cd position wait", s, Len(s), 0
  119. If (fPlaying) Then
  120.     cmd = "play cd from " & CStr(CLng(s) - fastForwardSpeed * 1000)
  121.     cmd = "seek cd to " & CStr(CLng(s) - fastForwardSpeed * 1000)
  122. End If
  123. mciSendString cmd, 0, 0, 0
  124. SendMCIString "set cd time format tmsf", True
  125. Update
  126. End Sub
  127. Private Sub Update()
  128. Static s As String * 30
  129. mciSendString "status cd media present", s, Len(s), 0
  130. If (CBool(s)) Then
  131.     If (fCDLoaded = False) Then
  132.         mciSendString "status cd number of tracks wait", s, Len(s), 0
  133.         numTracks = CInt(Mid$(s, 1, 2))
  134.         MnuEject.Enabled = True
  135.         
  136.              If (numTracks = 1) Then
  137.             Exit Sub
  138.         End If
  139.         
  140.         mciSendString "status cd length wait", s, Len(s), 0
  141.       
  142.         
  143.         Dim i As Integer
  144.         For i = 1 To numTracks
  145.             cmd = "status cd length track " & i
  146.             mciSendString cmd, s, Len(s), 0
  147.           
  148.         Next
  149.         MnuPlay.Enabled = True
  150.         MnuPause.Enabled = True
  151.         
  152.         MnuStop.Enabled = True
  153.         fCDLoaded = True
  154.         SendMCIString "seek cd to 1", True
  155.     End If
  156.     mciSendString "status cd position", s, Len(s), 0
  157.     Track = CInt(Mid$(s, 1, 2))
  158.     Min = CInt(Mid$(s, 4, 2))
  159.     Sec = CInt(Mid$(s, 7, 2))
  160.     mciSendString "status cd mode", s, Len(s), 0
  161.     fPlaying = (Mid$(s, 1, 7) = "playing")
  162.     MnuEject.Enabled = True
  163. End If
  164. End Sub
  165. Private Sub Timer1_Timer()
  166. Update
  167. End Sub
  168.